home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / metamail / contrib / ServiceMail / src / services / listserv.tcl < prev    next >
Encoding:
Text File  |  1993-05-07  |  3.9 KB  |  125 lines
  1. # listserv
  2. #
  3. # 2-Mar-83 weber@eitech.com changed mv to cp, thanks to ysato@etl.go.jp
  4. # 20-Nov-92 weber@eitech.com passed inputs variable for get command
  5. # 19-Nov-92 weber@eitech.com restructured to handle multiple commands in body
  6. # 19-Nov-92 weber@eitech.com added sensibility checks on (un)subscribe
  7. # 18-Nov-92 weber@eitech.com added privacy check to recipients command
  8. # 18-Nov-92 weber@eitech.com added get, which, release commands
  9. # 25-Jun-92 weber@eitech.com updated to new parameter format
  10. # 1-Jun-92 weber@eitech.com
  11. #
  12. # This service mimicks many of the commands in the listserv package
  13. # for mailing list maintenance.  Mailing lists must be manually created;
  14. # e.g., to create a list called "mylist", do a "touch ~/Lists/mylist" and
  15. # then add the following line to your system's /etc/aliases file:
  16. # "mylist: :include:~/Lists/mylist" (where you have to replace the "~"
  17. # with services' home directory on your system).
  18. #
  19. proc listserv {switches envelope inputs} {
  20.     if {$switches == ""} {
  21.     set fid [open [getfield $inputs FILE] r]
  22.     set needshelp 1
  23.     while {[gets $fid switches] >= 0 && $switches != "--"} {
  24.         if {[llength $switches]} {
  25.         set needshelp 0
  26.         listservcommand $switches $envelope ""
  27.         }
  28.     }
  29.     close $fid
  30.     if {$needshelp} {
  31.         listservcommand help $envelope ""
  32.     }
  33.     } {
  34.         listservcommand $switches $envelope $inputs
  35.     }
  36.     return 0
  37. }
  38.  
  39. proc listservcommand {switches envelope inputs} {
  40.     cd ~/Lists
  41.     set release "3.0"
  42.     set mlist [string tolower [lindex $switches 1]]
  43.     set person [getfield $envelope REPLYTO]
  44.     set pattern [format "^%s" $person]
  45.     case  [string tolower [lindex $switches 0]] {
  46.     subscribe {
  47.         if {[file exists $mlist]} {
  48.         if {[catch "exec grep -i -s $pattern $mlist"]} {
  49.             exec cp -p $mlist .$mlist
  50.             set fid [open $mlist a]
  51.             puts $fid [format "%s (%s)" $person [lrange $switches 2 end]]
  52.             close $fid
  53.             setfield response STRING "You are now on the $mlist mailing list."
  54.         } {
  55.             setfield response STRING "You are already on the $mlist mailing list."
  56.         }
  57.         } {
  58.         setfield response STRING "Sorry, I don't maintain a $mlist mailing list."
  59.         }
  60.     }
  61.     { unsubscribe signoff }  {
  62.         if {[file exists $mlist]} {
  63.         if {[catch "exec grep -i -s $pattern $mlist"]} {
  64.             setfield response STRING "You were not on the $mlist mailing list."
  65.         } {
  66.             exec cp -p $mlist .$mlist
  67.             catch "exec grep -v -i $pattern .$mlist > $mlist"
  68.             setfield response STRING \
  69.               "You have been removed from the $mlist mailing list."
  70.         }
  71.         } {
  72.         setfield response STRING "Sorry, I don't maintain a $mlist mailing list."
  73.         }
  74.     }
  75.     { recipients review } {
  76.         if {[file exists $mlist]} {
  77.         file stat $mlist stats
  78.         if {$stats(mode) & 4} {
  79.             setfield response FILE $mlist
  80.         } {
  81.             setfield response STRING \
  82.             "Sorry, the $mlist mailing list is confidential."
  83.         }
  84.         } {
  85.         setfield response STRING \
  86.           "Sorry, I don't maintain a $mlist mailing list."
  87.         }
  88.     }
  89.     information {
  90.         if {[file exists $mlist.txt]} {
  91.         setfield response FILE $mlist.txt
  92.         } {
  93.         setfield response STRING \
  94.           "Sorry, I don't have information on the $mlist mailing list."
  95.         }
  96.     }
  97.     which {
  98.         catch "exec grep -l $pattern [glob {*}]" stuff
  99.         setfield response STRING $stuff
  100.         setfield response DESCRIPTION \
  101.                  "ServiceMail mailing lists at [exec hostname] to which you belong"
  102.     }
  103.     get {
  104.         return [invoke-service archive-request [lindex $switches 2] \
  105.                 $envelope $inputs]
  106.     }
  107.     release {
  108.         setfield response STRING "This is ServiceMail listserv release $release."
  109.     }
  110.     lists {
  111.         setfield response STRING [glob {*}]
  112.         setfield response DESCRIPTION "ServiceMail mailing lists at [exec hostname]"
  113.     }
  114.     help {
  115.         setfield response FILE [glob ~/src/man/listserv.man]
  116.         setfield response DESCRIPTION "help regarding ServiceMail(tm) listserv"
  117.     }
  118.     default {
  119.         setfield response STRING \
  120.           "Sorry, I don't support the listserv command [lindex $switches 0]"
  121.     }
  122.     }
  123.     return [mailout [turnaround $envelope] $response]
  124. }
  125.